FM Towns: Free Software Collection 4/FM Towns Free Software Collection 4 - Disc 1.iso/msdos/dbhamlog/editqsl.prg

Text File | 1991-10-18 | 3KB | 170 lines

*****************  検索修正 *****************
**************** EDITQSL.PRG **** T.Chino ***
CLEAR
SET ORDER TO 1
GOTO TOP
SET EXACT OFF
SET COLOR ON

SET COLOR TO BR
  @ 1,15   SAY "*************************************************"
  @ 2,15   SAY "*                                               *"
  @ 3,15   SAY "********************************** 修正QSL.PRG **"
SET COLOR TO GR
  @ 2,18   SAY "アマチュア 無 線 ＱＳＯ ログ 管 理 システム"

SET COLOR TO BG
 @  5,20 SAY "    -------------------------------"
 @  6,20 SAY "    *  呼出符号                   *"
 @  7,20 SAY "    -------------------------------"
SET COLOR TO G
 @  8,15 SAY " 交信月日                   氏名  "
 @ 10,15 SAY "     時間                   住所  "
 @ 12,15 SAY "   周波数                  JCC/G         GL"
 @ 14,15 SAY " 電波形式        MHz        QSL   "
 @ 16,15 SAY "                         交信回数 "
 @ 18,15 SAY "                             "

SET COLOR TO

DO WHILE .T. && ****************111***********

SET COLOR TO GR
STORE SPACE(10) TO C
  @ 22,1 SAY "                                                              "
  @ 23,1 SAY "                                                              "
  @ 22,15 SAY "  ＱＳＬ受領登録の呼出符号は  ? " GET C
  READ
  CLEAR GET

IF C="          "
 RETURN
ENDIF

C=TRIM(C)

SEEK C

STORE 1 TO N
DO WHILE .T. && ********2222

 IF EOF()
  EXIT
 ENDIF

IF CALL = C
 SKIP
 STORE N+1 TO N
ELSE
 SKIP -1
 EXIT
ENDIF
ENDDO && ***************222

DO WHILE .T. && ********333
SET CURS OFF

 IF EOF()
  EXIT
 ENDIF

SET COLOR TO GRI
 @  6,39 SAY " "+CALL
SET COLOR TO GR
 @  8,25 SAY " "+DTOC(MMDDYY)
 @ 10,25 SAY " "+TIME
 @ 12,25 SAY " "+FREQ
 @ 14,25 SAY " "+WAVE
 @  8,48 SAY " "+NAME
 @ 10,48 SAY " "+ADDRES
 @ 12,48 SAY " "+JCC_G
 @ 12,58 SAY " "+GL
 @ 14,48 SAY "              "
SET COLOR TO RI
 @ 14,48 SAY " "+QSL

IF QSL<>"OK"
 STORE "未" TO Q
 SET COLOR TO R
 @ 14,53 SAY ""+Q
ENDIF

SET COLOR TO GR
 @ 16,48 SAY "       "
IF CALL=C
 @ 16,48 SAY " "+STR((N-1),2)
ENDIF

SET COLOR TO BGI
 @ 20,9 SAY "ＲＥＴＵＲＮ　ＫＥＹで　ＱＳＬ受領マ－ク［ＯＫ］を書き込みます。"
SET COLOR TO GI
 STORE SPACE(1) TO ZB
 @ 22,15 SAY " 前後のＤＡＴＡ検索 ( ↑･↓ )                  "
SET COLOR TO BGI
 @ 22,47 SAY " [ WRITE=CR ]  "
SET COLOR TO RI
 @ 23,47 SAY " [ 中 止=ESC ] "
 @ 0,0 GET ZB
  READ
 CLEAR GET

 IF READKEY()=4 && ↑
 SKIP -1
 LOOP
 ENDIF

 IF READKEY()=5 && ↓
 SKIP
 LOOP
 ENDIF

 IF READKEY()=15 && RETURN
  SET COLOR TO
  @ 14,48 SAY "       "
  SET COLOR TO RI
  @ 14,48 SAY " "+"OK "
    REPLACE  QSL WITH "OK"
  EXIT
 ENDIF

 IF READKEY()=12 && ESC
  EXIT
 ENDIF

IF READKEY()=36 && HOME
  STOR ADDRES TO A && ADDRES
  STOR JCC_G  TO J && JCC_G
  STOR GL     TO G && GL
  STOR "OK"   TO Q && QSL
SET CURS ON
 DO WHILE READKEY()<>15 && RETURN
 @ 10,48 SAY "" GET A
 @ 12,48 SAY "" GET J
 @ 12,58 SAY "" GET G
 @ 14,48 SAY "          "
 @ 14,48 SAY "" GET Q
 READ
 CLEAR GET
 ENDDO

 REPLACE ADDRES WITH A ;
          JCC_G WITH J ;
             GL WITH G ;
            QSL WITH Q
  EXIT
 ENDIF

ENDDO && *************333

SET CURS ON
SET COLOR TO R
IF EOF()
@ 22,0 SAY " 該当する交信記録は有りません｡"
WAIT
LOOP
ELSE
LOOP
ENDIF
ENDDO && ************111